home *** CD-ROM | disk | FTP | other *** search
/ Aminet 5 / Aminet 5 - March 1995.iso / Aminet / util / gnu / a2_0b_Emacs_sr.lha / Emacs-19.25 / site-lisp / vm.el < prev    next >
Lisp/Scheme  |  1993-06-16  |  67KB  |  1,752 lines
  1. ;;; UNIX style mail reader for GNU Emacs
  2. ;;; Copyright (C) 1989 Kyle E. Jones
  3. ;;;
  4. ;;; This program is free software; you can redistribute it and/or modify
  5. ;;; it under the terms of the GNU General Public License as published by
  6. ;;; the Free Software Foundation; either version 1, or (at your option)
  7. ;;; any later version.
  8. ;;;
  9. ;;; This program is distributed in the hope that it will be useful,
  10. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. ;;; GNU General Public License for more details.
  13. ;;;
  14. ;;; You should have received a copy of the GNU General Public License
  15. ;;; along with this program; if not, write to the Free Software
  16. ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17.  
  18. ;; This is a set of Emacs-Lisp commands and support functions for
  19. ;; reading mail.  While a mail reader (RMAIL) is distributed with GNU
  20. ;; Emacs it converts a user's mailbox to BABYL format, a behavior I
  21. ;; find quite unpalatable.
  22. ;;
  23. ;; VM is similar to RMAIL in that it scoops mail from the system mailbox
  24. ;; into a primary inbox for reading, but the similarity ends there.
  25. ;; VM does not reformat the mailbox beyond reordering the headers
  26. ;; according to user preference, and adding a header used internally to
  27. ;; store message attributes.
  28. ;;
  29. ;; Entry points to VM are the commands vm and vm-visit-folder.
  30. ;;
  31. ;; If autoloading then the lines:
  32. ;;   (autoload 'vm "vm" nil t)
  33. ;;   (autoload 'vm-visit-folder "vm" nil t)
  34. ;; should appear in a user's .emacs or in default.el in the lisp
  35. ;; directory of the Emacs distribution.
  36. ;;
  37. ;; VM requires Emacs' etc/movemail to work on your system.
  38.  
  39. (provide 'vm)
  40.  
  41. (defvar vm-primary-inbox "~/INBOX"
  42.   "*Mail is moved from the system mailbox to this file for reading.")
  43.  
  44. (defvar vm-crash-box "~/INBOX.CRASH"
  45.   "*File in which to store mail temporarily while it is transferrred from
  46. the system mailbox to the primary inbox.  If the something happens
  47. during this mail transfer, any missing mail will be found in this file.
  48. VM will do crash recovery from this file automatically at startup, as
  49. necessary.")
  50.  
  51. (defvar vm-spool-files nil
  52.   "*If non-nil this variable's value should be a list of strings naming files
  53. that VM will check for incoming mail instead of the where VM thinks your
  54. system mailbox is.  This variable can be used to specify multiple spool files
  55. or to point VM in the right direction if its notion of your system mailbox is
  56. incorrect.")
  57.  
  58. (defvar vm-visible-headers
  59.   '("From:" "Sender:" "To:" "Apparently-To:" "Cc:" "Subject:" "Date:")
  60.   "*List of headers that should be visible when VM first displays a message.
  61. These should be listed in the order you wish them presented.
  62. Regular expressions are allowed.")
  63.  
  64. (defvar vm-highlighted-header-regexp nil
  65.   "*Regular expression that matches the beginnings of headers that should
  66. be highlighted when a message is first presented.  For exmaple setting
  67. this variable to \"^From\\\\|^Subject\" causes the From: and Subject:
  68. headers to be highlighted.")
  69.  
  70. (defvar vm-preview-lines 0
  71.   "*Non-nil value N causes VM to display the visible headers + N lines of text
  72. from a message when it is first presented.  The message is not actually marked
  73. as read until the message is exposed in its entirety.  Nil causes VM not to
  74. preview a message at all; it is displayed in its entirety when first
  75. presented and is marked as read.")
  76.  
  77. (defvar vm-preview-read-messages t
  78.   "*Non-nil value means to preview messages, even if they've already been read.
  79. A nil value causes VM to preview messages only if new or unread.")
  80.  
  81. (defvar vm-folder-type nil
  82.   "*Value specifies the type of mail folder VM should expect to read and
  83. write.  Nil means expect the UNIX style folders characterized by the
  84. \"\\n\\nFrom \" message separators.  The only other supported value for
  85. this variable is the symbol `mmdf' which causes VM to use
  86. \"^A^A^A^A\\n\" MMDF style leaders and trailers.")
  87.  
  88. (defvar vm-folder-directory nil
  89.   "*Directory where folders of mail are kept.")
  90.  
  91. (defvar vm-confirm-new-folders nil
  92.   "*Non-nil value causes interactive calls to vm-save-message
  93. to ask for confirmation before creating a new folder.")
  94.  
  95. (defvar vm-delete-empty-folders t
  96.   "*Non-nil value causes VM to remove empty (zero length) folder files
  97. after saving them.")
  98.  
  99. (defvar vm-included-text-prefix " > "
  100.   "*String used to prefix included text in replies.")
  101.  
  102. (defvar vm-auto-folder-alist nil
  103.   "*Non-nil value should be an alist that VM will use to choose a default
  104. folder name when messages are saved.  The alist should be of the form
  105. \((HEADER-NAME
  106.    (REGEXP . FOLDER-NAME) ...
  107.   ...))
  108. where HEADER-NAME and REGEXP are strings, and FOLDER-NAME is a string or an s-expression that evaluates to a string.
  109.  
  110. If any part of the contents of the message header named by HEADER-NAME
  111. is matched by the regular expression REGEXP, VM will evaluate the
  112. corresponding FOLDER-NAME and use the result as the default when
  113. prompting for a folder to save the message in.  If trhe resulting folder
  114. name is a relative pathname, then it will resolve to the directory named by
  115. vm-folder-directory, or the default-directory of the currently visited
  116. folder if vm-folder-directory is nil.
  117.  
  118. When FOLDER-NAME is evaluated, the current buffer will contain only the
  119. contents of the header named by HEADER-NAME.  It is safe to modify this
  120. buffer.  You can use the match data from any \\( ... \\) grouping
  121. constructs in REGEXP along with the function buffer-substring to build a
  122. folder name based on the header information.
  123.  
  124. Matching is case sensitive.")
  125.  
  126. (defvar vm-visit-when-saving nil
  127.   "*Non-nil causes VM to visit folders when saving messages.  This means
  128. VM will read the folder into Emacs and append the message to the buffer
  129. instead of appending to the folder file directly.  This behavior is
  130. ideal when folders are encrypted or compressed since appending plaintext
  131. to such files is a ghastly mistake.
  132.  
  133. Note the setting of this variable does not affect how the primary inbox
  134. is accessed, i.e. the primary inbox must be a plaintext file.")
  135.  
  136. (defvar vm-in-reply-to-format "%i"
  137.   "*String which specifies the format of the contents of the In-Reply-To
  138. header that is generated for replies.  See the documentation for the
  139. variable vm-summary-format for information on what this string may
  140. contain.  The format should *not* end with a newline.
  141. Nil means don't put an In-Reply-To: header in replies.")
  142.  
  143. (defvar vm-included-text-attribution-format "%F writes:\n"
  144.   "*String which specifies the format of the attribution that precedes the
  145. included text from a message in a reply.  See the documentation for the
  146. variable vm-summary-format for information on what this string may contain.
  147. Nil means don't attribute included text in replies.")
  148.  
  149. (defvar vm-forwarding-subject-format "forwarded message from %F"
  150.   "*String which specifies the format of the contents of the Subject
  151. header that is generated for a forwarded message.  See the documentation
  152. for the variable vm-summary-format for information on what this string
  153. may contain.  The format should *not* end with a newline.  Nil means
  154. leave the Subject header empty when forwarding.")
  155.  
  156. (defvar vm-summary-format "%2n %a %-17.17F %3m %2d %3l/%-5c \"%s\"\n"
  157.   "*String which specifies the message summary line format.
  158. The string may contain the printf-like `%' conversion specifiers which
  159. substitute information about the message into the final summary line.
  160.  
  161. Recognized specifiers are:
  162.    a - attribute indicators (always three characters wide)
  163.        The first char is  `D', `N', `U' or ` ' for deleted, new, unread
  164.        and read message respectively.
  165.        The second char is `F' for filed (saved) messages.
  166.        The third char is `R' if the message has been replied to.
  167.    c - number of characters in message (ignoring headers)
  168.    d - date of month message sent
  169.    f - author's address
  170.    F - author's full name (same as f if full name not found)
  171.    h - hour message sent
  172.    i - message ID
  173.    l - number of lines in message (ignoring headers)
  174.    m - month message sent
  175.    n - message number
  176.    s - message subject
  177.    w - day of the week message sent
  178.    y - year message sent
  179.    z - timezone of date when the message was sent
  180.  
  181. Use %% to get a single %.
  182.  
  183. A numeric field width may be specified between the `%' and the specifier;
  184. this causes right justification of the substituted string.  A negative field
  185. width causes left justification.
  186.  
  187. The field width may be followed by a `.' and a number specifying the maximum
  188. allowed length of the substituted string.  If the string is longer than this
  189. value it is truncated.
  190.  
  191. The summary format need not be one line per message but it must end with
  192. a newline, otherwise the message pointer will not be displayed correctly
  193. in the summary window.")
  194.  
  195. (defvar vm-mail-window-percentage 75
  196.   "*Percentage of the screen that should be used to show mail messages.
  197. The rest of the screen will be used by the summary buffer, if displayed.")
  198.  
  199. (defvar vm-mutable-windows t
  200.   "*This variable's value controls VM's window usage.
  201.  
  202. A value of t gives VM free run of the Emacs display; it will commandeer
  203. the entire screen for its purposes.
  204.  
  205. A value of nil restricts VM's window usage to the window from which
  206. it was invoked.  VM will not create, delete, or use any other windows,
  207. nor will it resize it's own window.
  208.  
  209. A value that is neither t nor nil allows VM to use other windows, but it
  210. will not create new ones, or resize or delete the current ones.")
  211.  
  212. (defvar vm-startup-with-summary nil
  213.   "*Value tells VM what to display when a folder is visited.
  214. Nil means display folder only, t means display the summary only.  A
  215. value that is neither t not nil means to display both folder and summary.
  216. The latter only works if the variable pop-up-windows's value is non-nil.
  217. See the documentation for vm-mail-window-percentage to see how to change how
  218. the screen is apportioned between the folder and summary windows.")
  219.  
  220. (defvar vm-follow-summary-cursor nil
  221.   "*Non-nil value causes VM to select the message under the cursor in the
  222. summary window before executing commands that operate on the current message.
  223. This occurs only when the summary buffer window is the selected window.")
  224.  
  225. (defvar vm-group-by nil
  226.   "*Non-nil value tells VM how to group message presentation.
  227. Currently, the valid non-nil values for this variable are
  228.   \"subject\", which causes messages with the same subject (ignoring
  229.     Re:'s) to be presented together,
  230.   \"author\", which causes messages with the same author to be presented
  231.     together, and
  232.   \"date-sent\", which causes message sent on the same day to be
  233.     presented together.
  234.   \"arrival-time\" which appears only for completeness, this is the
  235.     default behavior and is the same as nil.
  236.  
  237. The ordering of the messages in the folder itself is not altered, messages
  238. are simply numbered and ordered differently internally.")
  239.  
  240. (defvar vm-skip-deleted-messages t
  241.   "*Non-nil value causes VM's `n' and 'p' commands to skip over
  242. deleted messages.  If all messages are marked deleted then this variable
  243. is, of course, ignored.")
  244.  
  245. (defvar vm-skip-read-messages nil
  246.   "*Non-nil value causes VM's `n' and `p' commands to skip over
  247. message that have already been read in favor of new or unread messages.
  248. If there are no unread message then this variable is, of course, ignored.")
  249.  
  250. (defvar vm-move-after-deleting nil
  251.   "*Non-nil value causes VM's `d' command to automatically invoke
  252. vm-next-message or vm-previous-message after deleting, to move
  253. past the deleted messages.")
  254.  
  255. (defvar vm-delete-after-saving nil
  256.   "*Non-nil value causes VM automatically to mark messages for deletion
  257. after successfully saving them to a folder.")
  258.  
  259. (defvar vm-circular-folders 0
  260.   "*Value determines whether VM folders will be considered circular by
  261. various commands.  `Circular' means VM will wrap from the end of the folder
  262. to the start and vice versa when moving the message pointer or deleting,
  263. undeleting or saving messages before or after the current message.
  264.  
  265. A value of t causes all VM commands to consider folders circular.
  266.  
  267. A value of nil causes all of VM commands to signal an error if the start
  268. or end of the folder would have to be passed to complete the command.
  269. For movement commands, this occurs after the message pointer has been
  270. moved as far it can go.  For other commands the error occurs before any
  271. part of the command has been executed, i.e. no moves, saves, etc. will
  272. be done unless they can be done in their entirety.
  273.  
  274. A value that is not nil and not t causes only VM's movement commands to
  275. consider folders circular.  Saves, deletes and undeleted command will
  276. behave the same as if the value is nil.")
  277.  
  278. (defvar vm-search-using-regexps nil
  279.   "*Non-nil value causes VM's search command will interpret user input as a
  280. regular expression instead of as a literal string.")
  281.  
  282. (defvar vm-mode-hooks nil
  283.   "*List of hook functions to run when a buffer enters vm-mode.
  284. These hook functions should generally be used to set key bindings
  285. and local variables.  Mucking about in the folder buffer is certainly
  286. possible but it is not encouraged.")
  287.  
  288. (defvar vm-berkeley-mail-compatibility
  289.   (memq system-type '(berkeley-unix))
  290.   "*Non-nil means to read and write BSD Mail(1) style Status: headers.
  291. This makes sense if you plan to use VM to read mail archives created by
  292. Mail.")
  293.  
  294. (defvar vm-gargle-uucp nil
  295.   "*Non-nil value means to use a crufty regular expression that does
  296. surprisingly well at beautifying UUCP addresses that are substitued for
  297. %f as part of summary and attribution formats.")
  298.  
  299. (defvar vm-strip-reply-headers nil
  300.   "*Non-nil value causes VM to strip away all comments and extraneous text
  301. from the headers generated in reply messages.  If you use the \"fakemail\"
  302. program as distributed with Emacs, you probably want to set this variable to
  303. to t, because as of Emacs v18.52 \"fakemail\" could not handle unstripped
  304. headers.")
  305.  
  306. (defvar vm-rfc934-forwarding t
  307.   "*Non-nil value causes VM to use char stuffing as described in RFC 934
  308. when packaging a message to be forwarded.  This will allow the recipient
  309. to use a standard bursting agent on the message and act upon it as if it
  310. were sent directly.")
  311.  
  312. (defvar vm-inhibit-startup-message nil
  313.   "*Non-nil causes VM not to display its copyright notice, disclaimers
  314. etc. when started in the usual way.")
  315.  
  316. (defvar mail-yank-hooks nil
  317.   "*List of hooks functions called after yanking a message into a *mail*
  318. buffer.")
  319.  
  320. (defvar vm-mode-map nil
  321.   "Keymap for VM mode and VM Summary mode.")
  322.  
  323. (defconst vm-version "4.42"
  324.   "Version number of VM.")
  325.  
  326. ;; internal vars
  327. (defvar vm-message-list nil)
  328. (make-variable-buffer-local 'vm-message-list)
  329. (defvar vm-message-pointer nil)
  330. (make-variable-buffer-local 'vm-message-pointer)
  331. (defvar vm-last-message-pointer nil)
  332. (make-variable-buffer-local 'vm-last-message-pointer)
  333. (defvar vm-primary-inbox-p nil)
  334. (make-variable-buffer-local 'vm-primary-inbox-p)
  335. (defvar vm-visible-header-alist nil)
  336. (make-variable-buffer-local 'vm-visible-header-alist)
  337. (defvar vm-mail-buffer nil)
  338. (make-variable-buffer-local 'vm-mail-buffer)
  339. (defvar vm-summary-buffer nil)
  340. (make-variable-buffer-local 'vm-summary-buffer)
  341. (defvar vm-system-state nil)
  342. (make-variable-buffer-local 'vm-system-state)
  343. (defvar vm-undo-record-list nil)
  344. (make-variable-buffer-local 'vm-undo-record-list)
  345. (defvar vm-undo-record-pointer nil)
  346. (make-variable-buffer-local 'vm-undo-record-pointer)
  347. (defvar vm-messages-needing-display-update nil)
  348. (make-variable-buffer-local 'vm-messages-needing-display-update)
  349. (defvar vm-current-grouping nil)
  350. (make-variable-buffer-local 'vm-current-grouping)
  351. (defvar vm-last-save-folder nil)
  352. (make-variable-buffer-local 'vm-last-save-folder)
  353. (defvar vm-last-pipe-command nil)
  354. (make-variable-buffer-local 'vm-last-pipe-command)
  355. (defvar vm-messages-not-on-disk 0)
  356. (make-variable-buffer-local 'vm-messages-not-on-disk)
  357. (defvar vm-inhibit-write-file-hook nil)
  358. (defvar vm-session-beginning t)
  359. (defconst vm-spool-directory
  360.   (or (and (boundp 'rmail-spool-directory) rmail-spool-directory)
  361.       "/usr/spool/mail"))
  362. (defconst vm-attributes-header-regexp
  363.   "^X-VM-Attributes:\\(.*\n\\([ \t]+.*\n\\)*\\)")
  364. (defconst vm-v5-data-header-regexp "^X-VM-v5-Data:\\(.*\n\\([ \t]+.*\n\\)*\\)")
  365. (defconst vm-attributes-header "X-VM-Attributes:")
  366. (defconst vm-berkeley-mail-status-header "Status: ")
  367. (defconst vm-berkeley-mail-status-header-regexp "^Status: ..?\n")
  368. (defconst vm-generic-header-regexp "^[^:\n]+:\\(.*\n\\([ \t]+.*\n\\)*\\)")
  369. (defconst vm-header-regexp-format "^%s:[ \t]*\\(.*\\(\n[ \t]+.*\\)*\\)")
  370. (defconst vm-supported-groupings-alist
  371.   '(("arrival-time") ("subject") ("author") ("date-sent")))
  372. (defconst vm-total-count 0)
  373. (defconst vm-new-count 0)
  374. (defconst vm-unread-count 0)
  375. ;; for the mode line
  376. (defvar vm-ml-message-number nil)
  377. (make-variable-buffer-local 'vm-ml-message-number)
  378. (defvar vm-ml-highest-message-number nil)
  379. (make-variable-buffer-local 'vm-ml-highest-message-number)
  380. (defvar vm-ml-attributes-string nil)
  381. (make-variable-buffer-local 'vm-ml-attributes-string)
  382.  
  383. ;; general purpose macros and functions
  384. (defmacro vm-marker (pos &optional buffer)
  385.   (list 'set-marker '(make-marker) pos buffer))
  386.  
  387. (defmacro vm-increment (variable)
  388.   (list 'setq variable (list '1+ variable)))
  389.  
  390. (defmacro vm-decrement (variable)
  391.   (list 'setq variable (list '1- variable)))
  392.  
  393. (defun vm-abs (n) (if (< n 0) (- n) n))
  394.  
  395. ;; save-restriction flubs restoring the clipping region if you
  396. ;; (widen) and modify text outside the old region.
  397. ;; This should do it right.
  398. (defmacro vm-save-restriction (&rest forms)
  399.   (let ((vm-sr-clip (make-symbol "vm-sr-clip"))
  400.     (vm-sr-min (make-symbol "vm-sr-min"))
  401.     (vm-sr-max (make-symbol "vm-sr-max")))
  402.     (list 'let (list (list vm-sr-clip '(> (buffer-size)
  403.                       (- (point-max) (point-min)))))
  404.       (list 'and vm-sr-clip
  405.         (list 'setq vm-sr-min '(set-marker (make-marker) (point-min)))
  406.         (list 'setq vm-sr-max '(set-marker (make-marker) (point-max))))
  407.       (list 'unwind-protect (cons 'progn forms)
  408.         '(widen)
  409.         (list 'and vm-sr-clip
  410.               (list 'progn
  411.                 (list 'narrow-to-region vm-sr-min vm-sr-max)
  412.                 (list 'set-marker vm-sr-min nil)
  413.                 (list 'set-marker vm-sr-max nil)))))))
  414.  
  415. ;; macros and functions dealing with accessing messages struct fields
  416. (defun vm-make-message () (make-vector 20 nil))
  417.  
  418. ;; where message begins (From_ line)
  419. (defmacro vm-start-of (message) (list 'aref message 0))
  420. ;; where visible headers start
  421. (defun vm-vheaders-of (message)
  422.   (or (aref message 1)
  423.       (progn (vm-reorder-message-headers message)
  424.          (aref message 1))))
  425. ;; where text section starts
  426. (defmacro vm-text-of (message) (list 'aref message 2))
  427. ;; where message ends
  428. (defmacro vm-end-of (message) (list 'aref message 3))
  429. ;; message number
  430. (defmacro vm-number-of (message) (list 'aref message 4))
  431. ;; message attribute vector
  432. (defmacro vm-attributes-of (message) (list 'aref message 5))
  433. (defmacro vm-new-flag (message) (list 'aref (list 'aref message 5) 0))
  434. (defmacro vm-unread-flag (message) (list 'aref (list 'aref message 5) 1))
  435. (defmacro vm-deleted-flag (message) (list 'aref (list 'aref message 5) 2))
  436. (defmacro vm-filed-flag (message) (list 'aref (list 'aref message 5) 3))
  437. (defmacro vm-replied-flag (message) (list 'aref (list 'aref message 5) 4))
  438. ;; message size in bytes (as a string)
  439. (defmacro vm-byte-count-of (message) (list 'aref message 6))
  440. ;; weekday sent
  441. (defmacro vm-weekday-of (message) (list 'aref message 7))
  442. ;; month day
  443. (defmacro vm-monthday-of (message) (list 'aref message 8))
  444. ;; month sent
  445. (defmacro vm-month-of (message) (list 'aref message 9))
  446. ;; year sent
  447. (defmacro vm-year-of (message) (list 'aref message 10))
  448. ;; hour sent
  449. (defmacro vm-hour-of (message) (list 'aref message 11))
  450. ;; timezone
  451. (defmacro vm-zone-of (message) (list 'aref message 12))
  452. ;; message author's full name (Full-Name: or gouged from From:)
  453. (defmacro vm-full-name-of (message) (list 'aref message 13))
  454. ;; message author address (gouged from From:)
  455. (defmacro vm-from-of (message) (list 'aref message 14))
  456. ;; message ID (Message-Id:)
  457. (defmacro vm-message-id-of (message) (list 'aref message 15))
  458. ;; number of lines in message (as a string)
  459. (defmacro vm-line-count-of (message) (list 'aref message 16))
  460. ;; message subject (Subject:)
  461. (defmacro vm-subject-of (message) (list 'aref message 17))
  462. (defmacro vm-su-start-of (message) (list 'aref message 18))
  463. (defmacro vm-su-end-of (message) (list 'aref message 19))
  464.  
  465. (defmacro vm-set-start-of (message start) (list 'aset message 0 start))
  466. (defmacro vm-set-vheaders-of (message vh) (list 'aset message 1 vh))
  467. (defmacro vm-set-text-of (message text) (list 'aset message 2 text))
  468. (defmacro vm-set-end-of (message end) (list 'aset message 3 end))
  469. (defmacro vm-set-number-of (message n) (list 'aset message 4 n))
  470. (defmacro vm-set-attributes-of (message attrs) (list 'aset message 5 attrs))
  471. (defmacro vm-set-byte-count-of (message count) (list 'aset message 6 count))
  472. (defmacro vm-set-weekday-of (message val) (list 'aset message 7 val))
  473. (defmacro vm-set-monthday-of (message val) (list 'aset message 8 val))
  474. (defmacro vm-set-month-of (message val) (list 'aset message 9 val))
  475. (defmacro vm-set-year-of (message val) (list 'aset message 10 val))
  476. (defmacro vm-set-hour-of (message val) (list 'aset message 11 val))
  477. (defmacro vm-set-zone-of (message val) (list 'aset message 12 val))
  478. (defmacro vm-set-full-name-of (message author) (list 'aset message 13 author))
  479. (defmacro vm-set-from-of (message author) (list 'aset message 14 author))
  480. (defmacro vm-set-message-id-of (message id) (list 'aset message 15 id))
  481. (defmacro vm-set-line-count-of (message count) (list 'aset message 16 count))
  482. (defmacro vm-set-subject-of (message subject) (list 'aset message 17 subject))
  483. (defmacro vm-set-su-start-of (message start) (list 'aset message 18 start))
  484. (defmacro vm-set-su-end-of (message end) (list 'aset message 19 end))
  485.  
  486. (defun vm-text-end-of (message)
  487.   (- (vm-end-of message)
  488.      (cond ((eq vm-folder-type 'mmdf) 5)
  489.        (t 1))))
  490.  
  491. ;; The remaining routines in this group are part of the undo system.
  492.  
  493. ;; init
  494. (if vm-mode-map
  495.     ()
  496.   (setq vm-mode-map (make-keymap))
  497.   (suppress-keymap vm-mode-map)
  498.   (define-key vm-mode-map "h" 'vm-summarize)
  499.   (define-key vm-mode-map "\M-n" 'vm-next-unread-message)
  500.   (define-key vm-mode-map "\M-p" 'vm-previous-unread-message)
  501.   (define-key vm-mode-map "n" 'vm-next-message)
  502.   (define-key vm-mode-map "p" 'vm-previous-message)
  503.   (define-key vm-mode-map "N" 'vm-Next-message)
  504.   (define-key vm-mode-map "P" 'vm-Previous-message)
  505.   (define-key vm-mode-map "\t" 'vm-goto-message-last-seen)
  506.   (define-key vm-mode-map "\r" 'vm-goto-message)
  507.   (define-key vm-mode-map "t" 'vm-expose-hidden-headers)
  508.   (define-key vm-mode-map " " 'vm-scroll-forward)
  509.   (define-key vm-mode-map "b" 'vm-scroll-backward)
  510.   (define-key vm-mode-map "\C-?" 'vm-scroll-backward)
  511.   (define-key vm-mode-map "d" 'vm-delete-message)
  512.   (define-key vm-mode-map "u" 'vm-undelete-message)
  513.   (define-key vm-mode-map "k" 'vm-kill-subject)
  514.   (define-key vm-mode-map "f" 'vm-followup)
  515.   (define-key vm-mode-map "F" 'vm-followup-include-text)
  516.   (define-key vm-mode-map "r" 'vm-reply)
  517.   (define-key vm-mode-map "R" 'vm-reply-include-text)
  518.   (define-key vm-mode-map "z" 'vm-forward-message)
  519.   (define-key vm-mode-map "@" 'vm-send-digest)
  520.   (define-key vm-mode-map "*" 'vm-burst-digest)
  521.   (define-key vm-mode-map "m" 'vm-mail)
  522.   (define-key vm-mode-map "g" 'vm-get-new-mail)
  523.   (define-key vm-mode-map "G" 'vm-group-messages)
  524.   (define-key vm-mode-map "v" 'vm-visit-folder)
  525.   (define-key vm-mode-map "s" 'vm-save-message)
  526.   (define-key vm-mode-map "w" 'vm-save-message-sans-headers)
  527.   (define-key vm-mode-map "A" 'vm-auto-archive-messages)
  528.   (define-key vm-mode-map "S" 'vm-save-folder)
  529.   (define-key vm-mode-map "|" 'vm-pipe-message-to-command)
  530.   (define-key vm-mode-map "#" 'vm-expunge-folder)
  531.   (define-key vm-mode-map "q" 'vm-quit)
  532.   (define-key vm-mode-map "x" 'vm-quit-no-change)
  533.   (define-key vm-mode-map "?" 'vm-help)
  534.   (define-key vm-mode-map "\C-_" 'vm-undo)
  535.   (define-key vm-mode-map "\C-xu" 'vm-undo)
  536.   (define-key vm-mode-map "!" 'shell-command)
  537.   (define-key vm-mode-map "<" 'beginning-of-buffer)
  538.   (define-key vm-mode-map ">" 'vm-end-of-message)
  539.   (define-key vm-mode-map "\M-s" 'vm-isearch-forward)
  540.   (define-key vm-mode-map "=" 'vm-summarize)
  541.   (define-key vm-mode-map "\M-C" 'vm-show-copying-restrictions)
  542.   (define-key vm-mode-map "\M-W" 'vm-show-no-warranty)
  543.   (define-key vm-mode-map "\C-y" 'undefined))
  544.  
  545. (defun vm-mark-for-display-update (message)
  546.   (if (not (memq message vm-messages-needing-display-update))
  547.       (setq vm-messages-needing-display-update
  548.         (cons message vm-messages-needing-display-update))))
  549.  
  550. (defun vm-last (list) (while (cdr-safe list) (setq list (cdr list))) list)
  551.  
  552. (put 'folder-empty 'error-conditions '(folder-empty error))
  553. (put 'folder-empty 'error-message "Folder is empty")
  554.  
  555. (defun vm-error-if-folder-empty ()
  556.   (while (null vm-message-list)
  557.     (signal 'folder-empty nil)))
  558.  
  559. (defun vm-proportion-windows ()
  560.   (if vm-mail-buffer
  561.       (set-buffer vm-mail-buffer))
  562.   (if (not (one-window-p t))
  563.       (let ((mail-w (get-buffer-window (current-buffer)))
  564.         (n (- (window-height (get-buffer-window (current-buffer)))
  565.           (/ (* vm-mail-window-percentage
  566.             (- (screen-height)
  567.                (window-height (minibuffer-window))))
  568.              100)))
  569.         (old-w (selected-window)))
  570.     (if mail-w
  571.         (save-excursion
  572.           (select-window mail-w)
  573.           (shrink-window n)
  574.           (select-window old-w))))))
  575.  
  576. (defun vm-number-messages ()
  577.   (let ((n 1) (message-list vm-message-list))
  578.     (while message-list
  579.       (vm-set-number-of (car message-list) (int-to-string n))
  580.       (setq n (1+ n) message-list (cdr message-list)))
  581.     (setq vm-ml-highest-message-number (int-to-string (1- n)))))
  582.  
  583. (defun vm-match-visible-header (alist)
  584.   (catch 'match
  585.     (while alist
  586.       (if (looking-at (car (car alist)))
  587.       (throw 'match (car alist)))
  588.       (setq alist (cdr alist)))
  589.     nil))
  590.  
  591. (defun vm-delete-header ()
  592.   (if (looking-at vm-generic-header-regexp)
  593.       (delete-region (match-beginning 0) (match-end 0))))
  594.  
  595. ;; Build a chain of message structures.
  596. ;; Find the start and end of each message and fill end the relevant
  597. ;; fields in the message structures.
  598.  
  599. (defun vm-build-message-list ()
  600.   (save-excursion
  601.     (vm-build-visible-header-alist)
  602.     (let (tail-cons message prev-message case-fold-search marker
  603.       start-regexp sep-pattern trailer-length)
  604.       (if (eq vm-folder-type 'mmdf)
  605.       (setq start-regexp "^\001\001\001\001\n"
  606.         separator-string "\n\001\001\001\001\n\001\001\001\001"
  607.         trailer-length 6)
  608.     (setq start-regexp "^From "
  609.           separator-string "\n\nFrom "
  610.           trailer-length 2))
  611.       (if vm-message-list
  612.       (let ((mp vm-message-list)
  613.         (end (point-min)))
  614.         (while mp
  615.           (if (< end (vm-end-of (car mp)))
  616.           (setq end (vm-end-of (car mp))))
  617.           (setq mp (cdr mp)))
  618.         ;; move back past trailer so separator-string will match below
  619.         (goto-char (- end trailer-length))
  620.         (setq tail-cons (vm-last vm-message-list)))
  621.     (goto-char (point-min))
  622.     (if (looking-at start-regexp)
  623.         (progn
  624.           (setq message (vm-make-message) prev-message message)
  625.           (vm-set-start-of message (vm-marker (match-beginning 0)))
  626.           (setq vm-message-list (list message)
  627.             tail-cons vm-message-list))))
  628.       (while (search-forward separator-string nil t)
  629.     (setq marker (vm-marker (+ trailer-length (match-beginning 0)))
  630.           message (vm-make-message))
  631.     (vm-set-start-of message marker)
  632.     (if prev-message
  633.         (vm-set-end-of prev-message marker))
  634.     (if tail-cons
  635.         (progn
  636.           (setcdr tail-cons (list message))
  637.           (setq tail-cons (cdr tail-cons)
  638.             prev-message message))
  639.       (setq vm-message-list (list message)
  640.         tail-cons vm-message-list
  641.         prev-message message)))
  642.       (if prev-message
  643.       (vm-set-end-of prev-message (vm-marker (point-max)))))))
  644.  
  645. (defun vm-build-visible-header-alist ()
  646.   (let ((header-alist (cons nil nil))
  647.     (vheaders vm-visible-headers)
  648.     list)
  649.     (setq list header-alist)
  650.     (while vheaders
  651.       (setcdr list (cons (cons (car vheaders) nil) nil))
  652.       (setq list (cdr list) vheaders (cdr vheaders)))
  653.     (setq vm-visible-header-alist (cdr header-alist))))
  654.  
  655. ;; Group the headers that the user wants to see at the end of the headers
  656. ;; section so we can narrow to them.  The vheaders field of the
  657. ;; message struct is set.  This function is called on demand whenever
  658. ;; a vheaders field is discovered to be nil for a particular message.
  659.  
  660. (defun vm-reorder-message-headers (message)
  661.   (save-excursion
  662.     (vm-save-restriction
  663.      (let ((header-alist vm-visible-header-alist)
  664.        list buffer-read-only match-end-0
  665.        (inhibit-quit t)
  666.        (old-buffer-modified-p (buffer-modified-p)))
  667.        (goto-char (vm-start-of message))
  668.        (forward-line)
  669.        (while (and (not (= (following-char) ?\n))
  670.            (looking-at vm-generic-header-regexp))
  671.      (setq match-end-0 (match-end 0)
  672.            list (vm-match-visible-header header-alist))
  673.      (if (null list)
  674.          (goto-char match-end-0)
  675.        (if (cdr list)
  676.            (setcdr list 
  677.                (concat
  678.             (cdr list)
  679.             (buffer-substring (point) match-end-0)))
  680.          (setcdr list (buffer-substring (point) match-end-0)))
  681.        (delete-region (point) match-end-0)))
  682.        (vm-set-vheaders-of message (point-marker))
  683.        (setq list header-alist)
  684.        (while list
  685.      (if (cdr (car list))
  686.          (progn
  687.            (insert (cdr (car list)))
  688.            (setcdr (car list) nil)))
  689.      (setq list (cdr list)))
  690.        (set-buffer-modified-p old-buffer-modified-p)))))
  691.  
  692. ;; Read the attribute headers from the messages and store their contents
  693. ;; in attributes fields of the message structures.  If a message has no
  694. ;; attributes header assume it is new.  If a message already has
  695. ;; attributes don't bother checking the headers.
  696. ;;
  697. ;; Stores the position where the message text begins in the message struct.
  698.  
  699. (defun vm-read-attributes ()
  700.   (save-excursion
  701.     (let ((mp vm-message-list))
  702.       (setq vm-new-count 0
  703.         vm-unread-count 0
  704.         vm-total-count 0)
  705.       (while mp
  706.     (vm-increment vm-total-count)
  707.     (if (vm-attributes-of (car mp))
  708.         ()
  709.       (goto-char (vm-start-of (car mp)))
  710.       (search-forward "\n\n" (vm-text-end-of (car mp)) 0)
  711.       (vm-set-text-of (car mp) (point-marker))
  712.       (goto-char (vm-start-of (car mp)))
  713.       (cond ((re-search-forward vm-attributes-header-regexp
  714.                     (vm-text-of (car mp)) t)
  715.          (goto-char (match-beginning 1))
  716.          (vm-set-attributes-of (car mp)
  717.                        (condition-case ()
  718.                        (read (current-buffer))
  719.                      (error (vector t nil nil nil nil))))
  720.          ;; If attributes are unrecogniable just assume the
  721.          ;; message is new.
  722.          (cond ((or (not (vectorp (vm-attributes-of (car mp))))
  723.                 (not (= (length (vm-attributes-of (car mp)))
  724.                     5)))
  725.             (vm-set-attributes-of (car mp)
  726.                           (vector t nil nil nil nil)))))
  727.         ;; recognize version 5 header in case the user wants to
  728.         ;; switch back to version 5.
  729.         ((re-search-forward vm-v5-data-header-regexp
  730.                     (vm-text-of (car mp)) t)
  731.          (goto-char (match-beginning 1))
  732.          (vm-set-attributes-of (car mp)
  733.                        (condition-case ()
  734.                        (car (read (current-buffer)))
  735.                      (error (vector t nil nil nil nil))))
  736.          (let ((i 0) (v (vector nil nil nil nil nil)))
  737.            (while (< i 5)
  738.              (aset v i (aref (vm-attributes-of (car mp)) i))
  739.              (vm-increment i))
  740.            (vm-set-attributes-of (car mp) v)))
  741.         ((and vm-berkeley-mail-compatibility
  742.               (re-search-forward vm-berkeley-mail-status-header-regexp
  743.                      (vm-text-of (car mp)) t))
  744.          (vm-set-attributes-of (car mp) (vector nil (looking-at "R")
  745.                             nil nil nil)))
  746.         (t
  747.          (vm-set-attributes-of (car mp) (vector t nil nil nil nil)))))
  748.     (cond ((vm-deleted-flag (car mp))) ; don't count deleted messages
  749.           ((vm-new-flag (car mp))
  750.            (vm-increment vm-new-count))
  751.           ((vm-unread-flag (car mp))
  752.            (vm-increment vm-unread-count)))
  753.     (setq mp (cdr mp))))))
  754.  
  755. ;; Stuff the messages attributes back into the messages as headers.
  756. (defun vm-stuff-attributes ()
  757.   (save-excursion
  758.     (vm-save-restriction
  759.      (widen)
  760.      (let ((mp vm-message-list) attributes buffer-read-only
  761.        (old-buffer-modified-p (buffer-modified-p)))
  762.        (while mp
  763.      (setq attributes (vm-attributes-of (car mp)))
  764.      (goto-char (vm-start-of (car mp)))
  765.      (if (re-search-forward vm-attributes-header-regexp
  766.                 (vm-text-of (car mp)) t)
  767.          (delete-region (match-beginning 0) (match-end 0)))
  768.      (goto-char (vm-start-of (car mp)))
  769.      (if (re-search-forward vm-v5-data-header-regexp
  770.                 (vm-text-of (car mp)) t)
  771.          (delete-region (match-beginning 0) (match-end 0)))
  772.      (cond (vm-berkeley-mail-compatibility
  773.         (goto-char (vm-start-of (car mp)))
  774.         (if (re-search-forward vm-berkeley-mail-status-header-regexp
  775.                        (vm-text-of (car mp)) t)
  776.             (delete-region (match-beginning 0) (match-end 0)))
  777.         (cond ((not (vm-new-flag (car mp)))
  778.                (goto-char (vm-start-of (car mp)))
  779.                (forward-line)
  780.                (insert-before-markers
  781.             vm-berkeley-mail-status-header
  782.             (if (vm-unread-flag (car mp)) "" "R")
  783.             "O\n")))))
  784.      (goto-char (vm-start-of (car mp)))
  785.      (forward-line)
  786.      (insert-before-markers vm-attributes-header " "
  787.                 (prin1-to-string attributes) "\n")
  788.      (setq mp (cdr mp)))
  789.        (set-buffer-modified-p old-buffer-modified-p)))))
  790.       
  791. ;; Remove any message marked for deletion from the buffer and the
  792. ;; message list.
  793. (defun vm-gobble-deleted-messages ()
  794.   (save-excursion
  795.     (vm-save-restriction
  796.      (widen)
  797.      (let ((mp vm-message-list) prev buffer-read-only did-gobble)
  798.        (while mp
  799.      (if (not (vm-deleted-flag (car mp)))
  800.          (setq prev mp)
  801.        (setq did-gobble t)
  802.        (delete-region (vm-start-of (car mp))
  803.               (vm-end-of (car mp)))
  804.        (if (null prev)
  805.            (setq vm-message-list (cdr vm-message-list))
  806.          (setcdr prev (cdr mp))))
  807.      (setq mp (cdr mp)))
  808.        (if did-gobble
  809.        (progn
  810.          (vm-clear-expunge-invalidated-undos)
  811.          (if (null vm-message-list)
  812.          (setq overlay-arrow-position nil))
  813.          (cond ((and vm-last-message-pointer
  814.              (vm-deleted-flag (car vm-last-message-pointer)))
  815.             (setq vm-last-message-pointer nil)))
  816.          (cond ((and vm-message-pointer
  817.              (vm-deleted-flag (car vm-message-pointer)))
  818.             (setq vm-system-state nil)
  819.             (setq mp (cdr vm-message-pointer))
  820.             (while (and mp (vm-deleted-flag (car mp)))
  821.               (setq mp (cdr mp)))
  822.             (setq vm-message-pointer
  823.               (or mp (vm-last vm-message-list)))))
  824.          did-gobble ))))))
  825.  
  826. (defun vm-change-all-new-to-unread ()
  827.   (let ((mp vm-message-list))
  828.     (while mp
  829.       (if (vm-new-flag (car mp))
  830.       (progn
  831.         (vm-set-new-flag (car mp) nil)
  832.         (vm-set-unread-flag (car mp) t)))
  833.       (setq mp (cdr mp)))))
  834.  
  835. (defun vm-update-summary-and-mode-line ()
  836.   (setq vm-ml-message-number (vm-number-of (car vm-message-pointer)))
  837.   (cond ((vm-new-flag (car vm-message-pointer))
  838.      (setq vm-ml-attributes-string "new"))
  839.     ((vm-unread-flag (car vm-message-pointer))
  840.      (setq vm-ml-attributes-string "unread"))
  841.     (t (setq vm-ml-attributes-string "read")))
  842.   (cond ((vm-filed-flag (car vm-message-pointer))
  843.      (setq vm-ml-attributes-string
  844.            (concat vm-ml-attributes-string " filed"))))
  845.   (cond ((vm-replied-flag (car vm-message-pointer))
  846.      (setq vm-ml-attributes-string
  847.            (concat vm-ml-attributes-string " replied"))))
  848.   (cond ((vm-deleted-flag (car vm-message-pointer))
  849.      (setq vm-ml-attributes-string
  850.            (concat vm-ml-attributes-string " deleted"))))
  851.   (while vm-messages-needing-display-update
  852.     (vm-update-message-summary vm-messages-needing-display-update)
  853.     (setq vm-messages-needing-display-update
  854.       (cdr vm-messages-needing-display-update)))
  855.   (save-excursion
  856.     (set-buffer (other-buffer))
  857.     (set-buffer-modified-p (buffer-modified-p))))
  858.  
  859. (defun vm-goto-message (n)
  860.   "Go to the message numbered N.
  861. Interactively N is the prefix argument.  If no prefix arg is provided
  862. N is prompted for in the minibuffer."
  863.   (interactive "NGo to message: ")
  864.   (if vm-mail-buffer
  865.       (set-buffer vm-mail-buffer))
  866.   (vm-error-if-folder-empty)
  867.   (let ((cons (nthcdr (1- n) vm-message-list)))
  868.     (if (null cons)
  869.     (error "No such message."))
  870.     (if (eq vm-message-pointer cons)
  871.     (vm-preview-current-message)
  872.       (setq vm-last-message-pointer vm-message-pointer
  873.         vm-message-pointer cons)
  874.       (vm-set-summary-pointer (car vm-message-pointer))
  875.       (vm-preview-current-message))))
  876.  
  877. (defun vm-goto-message-last-seen ()
  878.   "Go to the message last previewed."
  879.   (interactive)
  880.   (if vm-mail-buffer
  881.       (set-buffer vm-mail-buffer))
  882.   (vm-error-if-folder-empty)
  883.   (if vm-last-message-pointer
  884.       (let (tmp)
  885.     (setq tmp vm-message-pointer
  886.           vm-message-pointer vm-last-message-pointer
  887.           vm-last-message-pointer tmp)
  888.     (vm-set-summary-pointer (car vm-message-pointer))
  889.     (vm-preview-current-message))))
  890.  
  891. (put 'beginning-of-folder 'error-conditions '(beginning-of-folder error))
  892. (put 'beginning-of-folder 'error-message "Beginning of folder")
  893. (put 'end-of-folder 'error-conditions '(end-of-folder error))
  894. (put 'end-of-folder 'error-message "End of folder")
  895.  
  896. (defun vm-check-count (count)
  897.   (if (>= count 0)
  898.       (if (< (length vm-message-pointer) count)
  899.       (signal 'end-of-folder nil))
  900.     (if (< (1+ (- (length vm-message-list) (length vm-message-pointer)))
  901.        (vm-abs count))
  902.     (signal 'beginning-of-folder nil))))
  903.  
  904. (defun vm-move-message-pointer (direction)
  905.   (let ((mp vm-message-pointer))
  906.     (if (eq direction 'forward)
  907.     (progn
  908.       (setq mp (cdr mp))
  909.       (if (null mp)
  910.           (if vm-circular-folders
  911.           (setq mp vm-message-list)
  912.         (signal 'end-of-folder nil))))
  913.       (if (eq mp vm-message-list)
  914.       (if vm-circular-folders
  915.           (setq mp (vm-last vm-message-list))
  916.         (signal 'beginning-of-folder nil))
  917.     (setq mp (let ((curr vm-message-list))
  918.            (while (not (eq (cdr curr) mp))
  919.              (setq curr (cdr curr)))
  920.            curr))))
  921.     (setq vm-message-pointer mp)))
  922.  
  923. (defun vm-should-skip-message (mp)
  924.   (or (and vm-skip-deleted-messages
  925.        (vm-deleted-flag (car mp)))
  926.       (and vm-skip-read-messages
  927.        (or (vm-deleted-flag (car mp))
  928.            (not (or (vm-new-flag (car mp))
  929.             (vm-unread-flag (car mp))))))))
  930.  
  931. (defun vm-next-message (&optional count retry)
  932.   "Go forward one message and preview it.
  933. With prefix arg COUNT, go forward COUNT messages.  A negative COUNT
  934. means go backward.  If the absolute value of COUNT > 1 the values of the
  935. variables vm-skip-deleted-messages and vm-skip-read-messages are
  936. ignored."
  937.   (interactive "p\np")
  938.   (if vm-mail-buffer
  939.       (set-buffer vm-mail-buffer))
  940.   (vm-error-if-folder-empty)
  941.   (or count (setq count 1))
  942.   (let ((oldmp vm-message-pointer)
  943.     (error)
  944.     (direction (if (> count 0) 'forward 'backward))
  945.     (count (vm-abs count)))
  946.     (cond
  947.      ((null vm-message-pointer)
  948.       (setq vm-message-pointer vm-message-list))
  949.      ((/= count 1)
  950.       (condition-case ()
  951.       (while (not (zerop count))
  952.         (vm-move-message-pointer direction)
  953.         (vm-decrement count))
  954.     (beginning-of-folder (setq error 'beginning-of-folder))
  955.     (end-of-folder (setq error 'end-of-folder))))
  956.      (t
  957.       (condition-case ()
  958.       (progn
  959.         (vm-move-message-pointer direction)
  960.         (while (and (not (eq oldmp vm-message-pointer))
  961.             (vm-should-skip-message vm-message-pointer))
  962.           (vm-move-message-pointer direction))
  963.         ;; Retry the move if we've gone a complete circle and we should
  964.         ;; skip the current message and there are other messages.
  965.         (and (eq vm-message-pointer oldmp) retry (cdr vm-message-list)
  966.          (vm-should-skip-message vm-message-pointer)
  967.          (vm-move-message-pointer direction)))
  968.     (beginning-of-folder
  969.      (setq vm-message-pointer oldmp)
  970.      (if retry
  971.          (vm-move-message-pointer direction)
  972.        (setq error 'beginning-of-folder)))
  973.     (end-of-folder
  974.      (setq vm-message-pointer oldmp)
  975.      (if retry
  976.          (vm-move-message-pointer direction)
  977.        (setq error 'end-of-folder))))))
  978.     (if (not (eq vm-message-pointer oldmp))
  979.     (progn
  980.       (setq vm-last-message-pointer oldmp)
  981.       (vm-set-summary-pointer (car vm-message-pointer))
  982.       (vm-preview-current-message)))
  983.     (if error
  984.     (signal error nil))))
  985.  
  986. (defun vm-previous-message (&optional count retry)
  987.   "Go back one message and preview it.
  988. With prefix arg COUNT, go backward COUNT messages.  A negative COUNT
  989. means go forward.  If the absolute value of COUNT > 1 the values of the
  990. variables vm-skip-deleted-messages and vm-skip-read-messages are
  991. ignored."
  992.   (interactive "p\np")
  993.   (or count (setq count 1))
  994.   (vm-next-message (- count) retry))
  995.  
  996. (defun vm-Next-message (&optional count)
  997.   "Like vm-next-message but will not skip messages."
  998.   (interactive "p")
  999.   (let (vm-skip-deleted-messages vm-skip-read-messages)
  1000.     (vm-next-message count)))
  1001.  
  1002. (defun vm-Previous-message (&optional count)
  1003.   "Like vm-previous-message but will not skip messages."
  1004.   (interactive "p")
  1005.   (let (vm-skip-deleted-messages vm-skip-read-messages)
  1006.     (vm-previous-message count)))
  1007.  
  1008. (defun vm-next-unread-message ()
  1009.   "Move forward to the nearest new or unread message, if there is one."
  1010.   (interactive)
  1011.   (if vm-mail-buffer
  1012.       (set-buffer vm-mail-buffer))
  1013.   (condition-case ()
  1014.       (let ((vm-skip-read-messages t)
  1015.         (oldmp vm-message-pointer))
  1016.     (vm-next-message)
  1017.     ;; in case vm-circular-folder is non-nil
  1018.     (and (eq vm-message-pointer oldmp) (signal 'end-of-folder nil)))
  1019.     (end-of-folder (error "No next unread message"))))
  1020.  
  1021. (defun vm-previous-unread-message ()
  1022.   "Move backward to the nearest new or unread message, if there is one."
  1023.   (interactive)
  1024.   (if vm-mail-buffer
  1025.       (set-buffer vm-mail-buffer))
  1026.   (condition-case ()
  1027.       (let ((vm-skip-read-messages t)
  1028.         (oldmp vm-message-pointer))
  1029.     (vm-previous-message)
  1030.     ;; in case vm-circular-folder is non-nil
  1031.     (and (eq vm-message-pointer oldmp) (signal 'beginning-of-folder nil)))
  1032.     (beginning-of-folder (error "No previous unread message"))))
  1033.  
  1034. (defun vm-preview-current-message ()
  1035.   (setq vm-system-state 'previewing)
  1036.   (widen)
  1037.   (narrow-to-region
  1038.    (vm-vheaders-of (car vm-message-pointer))
  1039.    (if vm-preview-lines
  1040.        (min
  1041.     (vm-text-end-of (car vm-message-pointer))
  1042.     (save-excursion
  1043.       (goto-char (vm-text-of (car vm-message-pointer)))
  1044.       (forward-line (if (natnump vm-preview-lines) vm-preview-lines 0))
  1045.       (point)))
  1046.      (vm-text-of (car vm-message-pointer))))
  1047.   (let ((w (get-buffer-window (current-buffer))))
  1048.     (and w (progn (set-window-start w (point-min))
  1049.           (set-window-point w (point-max))))
  1050.     (and w vm-highlighted-header-regexp
  1051.      (progn
  1052.        (save-restriction
  1053.          (narrow-to-region (point) (point))
  1054.          (sit-for 0))
  1055.        (goto-char (point-min))
  1056.        (while (re-search-forward vm-highlighted-header-regexp nil t)
  1057.          (save-restriction
  1058.            (goto-char (match-beginning 0))
  1059.            (looking-at vm-generic-header-regexp)
  1060.            (goto-char (match-beginning 1))
  1061.            (narrow-to-region (point-min) (point))
  1062.            (sit-for 0)
  1063.            (setq inverse-video t)
  1064.            (widen)
  1065.            (narrow-to-region (point-min) (match-end 1))
  1066.            (sit-for 0)
  1067.            (setq inverse-video nil)
  1068.            (goto-char (match-end 0)))))))
  1069.   (goto-char (point-max))
  1070.   ;; De Morgan's Theorems could clear away most of the following negations,
  1071.   ;; but the resulting code would be horribly obfuscated.
  1072.   (if (or (null vm-preview-lines)
  1073.       (and (not vm-preview-read-messages)
  1074.            (not (vm-new-flag (car vm-message-pointer)))
  1075.            (not (vm-unread-flag (car vm-message-pointer)))))
  1076.       ;; Don't sit and howl unless the mail buffer is visible.
  1077.       (vm-show-current-message (get-buffer-window (current-buffer)))
  1078.     (vm-update-summary-and-mode-line)))
  1079.  
  1080. (defun vm-show-current-message (&optional sit-and-howl)
  1081.   (setq vm-system-state 'reading)
  1082.   (save-excursion
  1083.     (goto-char (point-min))
  1084.     (widen)
  1085.     (narrow-to-region (point) (vm-text-end-of (car vm-message-pointer))))
  1086.   (cond ((vm-new-flag (car vm-message-pointer))
  1087.      (vm-set-new-flag (car vm-message-pointer) nil))
  1088.     ((vm-unread-flag (car vm-message-pointer))
  1089.      (vm-set-unread-flag (car vm-message-pointer) nil)))
  1090.   (vm-update-summary-and-mode-line)
  1091.   (cond (sit-and-howl
  1092.      (sit-for 0)
  1093.      (vm-howl-if-eom-visible))))
  1094.  
  1095. (defun vm-expose-hidden-headers ()
  1096.   "Expose headers omitted from vm-visible-headers."
  1097.   (interactive)
  1098.   (vm-follow-summary-cursor)
  1099.   (if vm-mail-buffer
  1100.       (set-buffer vm-mail-buffer))
  1101.   (vm-error-if-folder-empty)
  1102.   (save-excursion
  1103.     (goto-char (point-max))
  1104.     (widen)
  1105.     (narrow-to-region (point) (vm-start-of (car vm-message-pointer)))
  1106.     (let (w)
  1107.       (and (setq w (get-buffer-window (current-buffer)))
  1108.        (= (window-start w) (vm-vheaders-of (car vm-message-pointer)))
  1109.        (set-window-start w (vm-start-of (car vm-message-pointer)))))))
  1110.  
  1111. (defun vm-howl-if-eom-visible ()
  1112.   (let ((w (get-buffer-window (current-buffer))))
  1113.     (and w (pos-visible-in-window-p (point-max) w)
  1114.      (message "End of message %s from %s"
  1115.           (vm-number-of (car vm-message-pointer))
  1116.           (vm-su-full-name (car vm-message-pointer))))))
  1117.  
  1118. ;; message-changed is an old-fashoined local variable.
  1119. (defun vm-scroll-forward (&optional arg message-changed)
  1120.   "Scroll forward a screenful of text.
  1121. If the current message is being previewed, the message body is revealed.
  1122. If at the end of the current message, move to the next message."
  1123.   (interactive "P")
  1124.   (setq message-changed (vm-follow-summary-cursor))
  1125.   (if vm-mail-buffer
  1126.       (set-buffer vm-mail-buffer))
  1127.   (vm-error-if-folder-empty)
  1128.   (if (null (get-buffer-window (current-buffer)))
  1129.       (progn
  1130.     (if vm-mutable-windows
  1131.         (let ((pop-up-windows
  1132.            (and pop-up-windows (eq vm-mutable-windows t))))
  1133.           (display-buffer (current-buffer)))
  1134.       (switch-to-buffer (current-buffer)))
  1135.     (if (and vm-summary-buffer (get-buffer-window vm-summary-buffer)
  1136.          (eq vm-mutable-windows t))
  1137.         (vm-proportion-windows))
  1138.     (if (eq vm-system-state 'previewing)
  1139.         (vm-show-current-message t)
  1140.       (vm-howl-if-eom-visible)))
  1141.     (if (eq vm-system-state 'previewing)
  1142.     (vm-show-current-message t)
  1143.       (if message-changed
  1144.       (vm-howl-if-eom-visible)
  1145.     (let ((w (get-buffer-window (current-buffer)))
  1146.           (old-w (selected-window)))
  1147.       (unwind-protect
  1148.           (progn
  1149.         (select-window w)
  1150.         (if (not (eq (condition-case () (scroll-up arg)
  1151.                    (end-of-buffer (if (null arg)
  1152.                           (progn
  1153.                             (vm-next-message)
  1154.                             'next-message))))
  1155.                  'next-message))
  1156.             (vm-howl-if-eom-visible)))
  1157.         (select-window old-w)))))))
  1158.  
  1159. (defun vm-scroll-backward (&optional arg)
  1160.   "Scroll backward a screenful of text."
  1161.   (interactive "P")
  1162.   (vm-follow-summary-cursor)
  1163.   (if vm-mail-buffer
  1164.       (set-buffer vm-mail-buffer))
  1165.   (vm-error-if-folder-empty)
  1166.   (if (null (get-buffer-window (current-buffer)))
  1167.       (progn
  1168.     (if vm-mutable-windows
  1169.         (let ((pop-up-windows
  1170.            (and pop-up-windows (eq vm-mutable-windows t))))
  1171.           (display-buffer (current-buffer)))
  1172.       (switch-to-buffer (current-buffer)))
  1173.     (if (and vm-summary-buffer (get-buffer-window vm-summary-buffer)
  1174.          (eq vm-mutable-windows t))
  1175.         (vm-proportion-windows)))
  1176.     (let ((w (get-buffer-window (current-buffer)))
  1177.       (old-w (selected-window)))
  1178.       (unwind-protect
  1179.       (progn
  1180.         (select-window w)
  1181.         (scroll-down arg))
  1182.     (select-window old-w)))))
  1183.  
  1184. (defun vm-end-of-message ()
  1185.   "Displays the end of the current message, exposing and marking it read
  1186. as necessary."
  1187.   (interactive)
  1188.   (vm-follow-summary-cursor)
  1189.   (if vm-mail-buffer
  1190.       (set-buffer vm-mail-buffer))
  1191.   (vm-error-if-folder-empty)
  1192.   (if (eq vm-system-state 'previewing)
  1193.       (vm-show-current-message))
  1194.   (goto-char (point-max))
  1195.   (vm-howl-if-eom-visible))
  1196.  
  1197. (defun vm-quit-no-change ()
  1198.   "Exit VM without saving changes made to the folder."
  1199.   (interactive)
  1200.   (vm-quit t))
  1201.  
  1202. (defun vm-quit (&optional no-change)
  1203.   "Quit VM, saving changes and expunging messages marked for deletion.
  1204. New messages are changed to unread."
  1205.   (interactive)
  1206.   (if vm-mail-buffer
  1207.       (set-buffer vm-mail-buffer))
  1208.   (and no-change (buffer-modified-p)
  1209.        (not (zerop vm-messages-not-on-disk))
  1210.        ;; Folder may have been saved with C-x C-s and atriutes may have
  1211.        ;; been changed after that; in that case vm-messages-not-on-disk
  1212.        ;; would not have been zeroed.  However, all modification flag
  1213.        ;; undos are cleared if VM actually modifies the folder buffer
  1214.        ;; (as opposed to the folder's attributes), so this can be used
  1215.        ;; to verify that there are indeed unsaved messages.
  1216.        (null (assq 'set-buffer-modified-p vm-undo-record-list))
  1217.        (not (y-or-n-p
  1218.          (format "%d message%s have not been saved to disk, exit anyway? "
  1219.              vm-messages-not-on-disk
  1220.              (if (= 1 vm-messages-not-on-disk) "" "s"))))
  1221.        (error "Aborted"))
  1222.   (let ((inhibit-quit t))
  1223.     (if (not no-change)
  1224.     (vm-change-all-new-to-unread))
  1225.     (if (and (buffer-modified-p) (not no-change))
  1226.     (vm-save-folder t))
  1227.     (let ((summary-buffer vm-summary-buffer)
  1228.       (mail-buffer (current-buffer)))
  1229.       (if summary-buffer
  1230.       (progn
  1231.         (setq overlay-arrow-position nil)
  1232.         (if (eq vm-mutable-windows t)
  1233.         (delete-windows-on vm-summary-buffer))
  1234.         (kill-buffer summary-buffer)))
  1235.       (set-buffer mail-buffer)
  1236.       (set-buffer-modified-p nil)
  1237.       (kill-buffer (current-buffer)))
  1238.     ;; Make sure we are now dealing with the buffer and window that
  1239.     ;; would be selected were we to give up control now.
  1240.     (set-buffer (window-buffer (selected-window)))
  1241.     ;; If we land on a buffer that VM knows about
  1242.     ;; do some nice things for the user, if we're allowed.
  1243.     (cond ((and (eq major-mode 'vm-mode) (eq vm-mutable-windows t))
  1244.        (if (null vm-startup-with-summary)
  1245.            (delete-other-windows)
  1246.          (condition-case () (vm-summarize t) (error nil))
  1247.          (and (not (eq major-mode 'vm-summary-mode))
  1248.           (eq vm-startup-with-summary t)
  1249.           (not (one-window-p t))
  1250.           vm-summary-buffer
  1251.           (get-buffer-window vm-summary-buffer)
  1252.           (progn
  1253.             (select-window (get-buffer-window vm-summary-buffer))
  1254.             (delete-other-windows)))))
  1255.       ((eq major-mode 'vm-summary-mode)
  1256.        (cond ((eq vm-startup-with-summary nil)
  1257.           (switch-to-buffer vm-mail-buffer)
  1258.           (and (not (one-window-p t)) (eq vm-mutable-windows t)
  1259.                (delete-other-windows)))
  1260.          ((not (eq vm-startup-with-summary t))
  1261.           (let ((pop-up-windows
  1262.              (and pop-up-windows (eq vm-mutable-windows t))))
  1263.             (display-buffer vm-mail-buffer))
  1264.           (if (eq vm-mutable-windows t)
  1265.               (if (eq major-mode 'vm-summary-mode)
  1266.               (vm-proportion-windows)
  1267.             (switch-to-buffer vm-summary-buffer))))
  1268.          ((eq vm-mutable-windows t)
  1269.           (delete-other-windows)))))))
  1270.  
  1271. ;; This allows C-x C-s to do the right thing for VM mail buffers.
  1272. ;; Note that deleted messages are not expunged.
  1273. (defun vm-write-file-hook ()
  1274.   (if (not (eq major-mode 'vm-mode))
  1275.       ()
  1276.     (if vm-inhibit-write-file-hook
  1277.     ()
  1278.       ;; The vm-save-restriction isn't really necessary here (since
  1279.       ;; vm-stuff-atributes cleans up after itself) but should remain
  1280.       ;; as a safeguard against the time when other stuff is added here.
  1281.       (vm-save-restriction
  1282.        (let ((inhibit-quit t)
  1283.          (buffer-read-only))
  1284.      (vm-stuff-attributes)
  1285.      nil )))))
  1286.  
  1287. (defun vm-save-folder (&optional quitting)
  1288.   "Save current folder to disk."
  1289.   (interactive)
  1290.   (if vm-mail-buffer
  1291.       (set-buffer vm-mail-buffer))
  1292.   (if (buffer-modified-p)
  1293.       (let ((inhibit-quit t))
  1294.     ;; may get error if folder is emptied by the expunge.
  1295.     (condition-case ()
  1296.         (vm-expunge-folder quitting t)
  1297.       (error nil))
  1298.     (vm-stuff-attributes)
  1299.     (let ((vm-inhibit-write-file-hook t))
  1300.       (save-buffer))
  1301.     (setq vm-messages-not-on-disk 0)
  1302.     (and (zerop (buffer-size)) vm-delete-empty-folders
  1303.          (condition-case ()
  1304.          (progn
  1305.            (delete-file buffer-file-name)
  1306.            (message "%s removed" buffer-file-name))
  1307.            (error nil)))
  1308.     (if (not quitting)
  1309.         (if vm-message-pointer
  1310.         (vm-update-summary-and-mode-line)
  1311.           (vm-next-message))))))
  1312.  
  1313. (defun vm-visit-folder (folder)
  1314.   "Visit a mail file.
  1315. VM will parse and present its messages to you in the usual way."
  1316.   (interactive
  1317.    (list (read-file-name
  1318.       "Visit folder: " (if vm-folder-directory
  1319.                    (expand-file-name vm-folder-directory)
  1320.                  default-directory) nil t)))
  1321.   (if vm-mail-buffer
  1322.       (set-buffer vm-mail-buffer))
  1323.   (vm folder))
  1324.  
  1325. (defun vm-help ()
  1326.   "Display VM command and variable information."
  1327.   (interactive)
  1328.   (if (and vm-mail-buffer (get-buffer-window vm-mail-buffer))
  1329.       (set-buffer vm-mail-buffer))
  1330.   (let ((pop-up-windows (and pop-up-windows (eq vm-mutable-windows t))))
  1331.     (cond
  1332.      ((eq last-command 'vm-help)
  1333.       (describe-mode))
  1334.      ((eq vm-system-state 'previewing)
  1335.       (message "Type SPC to read message, n previews next message   (? gives more help)"))
  1336.      ((eq vm-system-state 'reading)
  1337.       (message "SPC and b scroll, (d)elete, (s)ave, (n)ext, (r)eply   (? gives more help)"))
  1338.      (t (describe-mode)))))
  1339.  
  1340. (defun vm-move-mail (source destination)
  1341.   (call-process "movemail" nil nil nil (expand-file-name source)
  1342.         (expand-file-name destination)))
  1343.  
  1344. (defun vm-gobble-crash-box ()
  1345.   (save-excursion
  1346.     (vm-save-restriction
  1347.      (widen)
  1348.      (let ((opoint-max (point-max)) crash-buf buffer-read-only
  1349.        (old-buffer-modified-p (buffer-modified-p))
  1350.        ;; crash box could contain a letter bomb...
  1351.        ;; force user notification of file variables.
  1352.        (inhibit-local-variables t))
  1353.        (setq crash-buf (find-file-noselect vm-crash-box))
  1354.        (goto-char (point-max))
  1355.        (insert-buffer-substring crash-buf
  1356.                 1 (1+ (save-excursion
  1357.                     (set-buffer crash-buf)
  1358.                     (widen)
  1359.                     (buffer-size))))
  1360.        (write-region opoint-max (point-max) buffer-file-name t t)
  1361.        (backup-buffer)
  1362.        ;; make sure primary inbox is private.  384 = octal 600
  1363.        (condition-case () (set-file-modes buffer-file-name 384) (error nil))
  1364.        (set-buffer-modified-p old-buffer-modified-p)
  1365.        (kill-buffer crash-buf)
  1366.        (condition-case () (delete-file vm-crash-box)
  1367.      (error nil))))))
  1368.  
  1369. (defun vm-get-spooled-mail ()
  1370.   (let ((spool-files (or vm-spool-files
  1371.              (list (concat vm-spool-directory (user-login-name)))))
  1372.     (inhibit-quit t)
  1373.     (got-mail))
  1374.     (if (file-exists-p vm-crash-box)
  1375.     (progn
  1376.       (message "Recovering messages from crash box...")
  1377.       (vm-gobble-crash-box)
  1378.       (message "Recovering messages from crash box... done")
  1379.       (setq got-mail t)))
  1380.     (while spool-files
  1381.       (if (file-readable-p (car spool-files))
  1382.       (progn
  1383.         (message "Getting new mail from %s..." (car spool-files))
  1384.         (vm-move-mail (car spool-files) vm-crash-box)
  1385.         (vm-gobble-crash-box)
  1386.         (message "Getting new mail from %s... done" (car spool-files))
  1387.         (setq got-mail t)))
  1388.       (setq spool-files (cdr spool-files)))
  1389.     got-mail ))
  1390.  
  1391. (defun vm-get-new-mail ()
  1392.   "Move any new mail that has arrived in the system mailbox into the
  1393. primary inbox.  New mail is appended to the disk and buffer copies of
  1394. the primary inbox.
  1395.  
  1396. This command is valid only from the primary inbox buffer."
  1397.   (interactive)
  1398.   (if vm-mail-buffer
  1399.       (set-buffer vm-mail-buffer))
  1400.   (if (not vm-primary-inbox-p)
  1401.       (error "This is not your primary inbox."))
  1402.   (if (not (and (vm-get-spooled-mail) (vm-assimilate-new-messages)))
  1403.       (message "No new mail.")
  1404.     (vm-emit-totals-blurb)
  1405.     ;; If there's a current grouping, then the summary has already
  1406.     ;; been redone in vm-group-messages.
  1407.     (if (and vm-summary-buffer (not vm-current-grouping))
  1408.     (progn
  1409.       (vm-do-summary)
  1410.       (vm-emit-totals-blurb)))
  1411.     (vm-thoughtfully-select-message)
  1412.     (if vm-summary-buffer
  1413.     (vm-set-summary-pointer (car vm-message-pointer)))))
  1414.  
  1415. (defun vm-emit-totals-blurb ()
  1416.   (message "%d message%s, %d new, %d unread."
  1417.        vm-total-count (if (= vm-total-count 1) "" "s")
  1418.        vm-new-count vm-unread-count))
  1419.  
  1420. (defun vm-find-first-unread-message ()
  1421.   (let (mp unread-mp)
  1422.     (setq mp vm-message-list)
  1423.     (while mp
  1424.       (if (and (vm-new-flag (car mp)) (not (vm-deleted-flag (car mp))))
  1425.       (setq unread-mp mp mp nil)
  1426.     (setq mp (cdr mp))))
  1427.     (if (null unread-mp)
  1428.     (progn
  1429.       (setq mp vm-message-list)
  1430.       (while mp
  1431.         (if (and (vm-unread-flag (car mp))
  1432.              (not (vm-deleted-flag (car mp))))
  1433.         (setq unread-mp mp mp nil)
  1434.           (setq mp (cdr mp))))))
  1435.     unread-mp))
  1436.  
  1437. ;; returns non-nil if there were any new messages
  1438. (defun vm-assimilate-new-messages ()
  1439.   (let ((tail-cons (vm-last vm-message-list))
  1440.     (new-messages-p (null vm-message-pointer)))
  1441.     (vm-save-restriction
  1442.      (widen)
  1443.      (vm-build-message-list)
  1444.      (vm-read-attributes)
  1445.      (setq new-messages-p (or new-messages-p (cdr tail-cons)))
  1446.      (if (and vm-current-grouping new-messages-p)
  1447.      (condition-case data
  1448.          (vm-group-messages vm-current-grouping)
  1449.        ;; presumably an unsupported grouping
  1450.        (error (message (car (cdr data)))
  1451.           (sleep-for 2)
  1452.           (vm-number-messages)))
  1453.        (vm-number-messages)))
  1454.     new-messages-p ))
  1455.  
  1456. (defun vm-thoughtfully-select-message ()
  1457.   ;; This is called after new messages have been assimilated in a folder.
  1458.   ;; We move to a new message only if the user is not "reading" the current
  1459.   ;; message, or if there is no current message.
  1460.   ;;
  1461.   ;; Most of the complications in the `if' test below are due to the presence
  1462.   ;; of the variables vm-preview-lines and vm-preview-read-messages.
  1463.   ;; These can cause previewing never to be done, or not be done for
  1464.   ;; specific messages.  In these cases VM assumes a user is "reading"
  1465.   ;; an exposed message if the top of the message is not visible in the
  1466.   ;; folder buffer window.
  1467.   (if (or (null vm-message-pointer)
  1468.       (not (eq vm-system-state 'reading))
  1469.       (and (or (null vm-preview-lines)
  1470.            (and (not vm-preview-read-messages)
  1471.             (not (vm-new-flag (car vm-message-pointer)))
  1472.             (not (vm-unread-flag (car vm-message-pointer)))))
  1473.            (let ((w (get-buffer-window (current-buffer))))
  1474.          (and w (pos-visible-in-window-p (point-min) w)))))
  1475.       (let ((mp (vm-find-first-unread-message)))
  1476.     (if mp
  1477.         (progn
  1478.           (if vm-message-pointer
  1479.           (setq vm-last-message-pointer vm-message-pointer
  1480.             vm-message-pointer mp)
  1481.         (setq vm-message-pointer mp))
  1482.           (vm-preview-current-message))
  1483.       (if (null vm-message-pointer)
  1484.           (vm-Next-message))))))
  1485.  
  1486. (defun vm-display-startup-message ()
  1487.   (if (sit-for 5)
  1488.       (let ((lines
  1489.          '(
  1490. "You may give out copies of VM.  Type \\[vm-show-copying-restrictions] to see the conditions"
  1491. "VM comes with ABSOLUTELY NO WARRANTY; type \\[vm-show-no-warranty] for full details"
  1492.            )))
  1493.     (message "VM %s, Copyright (C) 1989 Kyle E. Jones; type ? for help"
  1494.          vm-version)
  1495.     (while (and (sit-for 4) lines)
  1496.       (message (substitute-command-keys (car lines)))
  1497.       (setq lines (cdr lines)))))
  1498.   (message ""))
  1499.  
  1500. (defun vm (&optional folder)
  1501.   "Read mail under Emacs.
  1502. Optional first arg FOLDER specifies the folder to visit.  It defaults
  1503. to the value of vm-primary-inbox.  The folder buffer is put into VM
  1504. mode, a major mode for reading mail.
  1505.  
  1506. Visiting the primary inbox causes any contents of the system mailbox to
  1507. be moved and appended to the resulting buffer.
  1508.  
  1509. All the messages can be read by repeatedly pressing SPC.  Messages are
  1510. marked for deletion with `d', and saved to a folder with `s'.  Quitting
  1511. VM with `q' expunges messages marked for deletion and saves the buffered
  1512. folder to disk.
  1513.  
  1514. See the documentation for vm-mode for more information."
  1515.   (interactive)
  1516.   (if vm-session-beginning
  1517.       (progn
  1518.     (random t)
  1519.     (load "~/.vm" t t t)
  1520.     (load "vm-undo")
  1521.     (load "vm-summary")))
  1522.   (if vm-mail-buffer
  1523.       (set-buffer vm-mail-buffer))
  1524.   ;; set inhibit-local-varaibles non-nil to protect
  1525.   ;; against letter bombs.
  1526.   (let ((inhibit-local-variables t))
  1527.     (setq mail-buffer (find-file-noselect
  1528.                (or folder (expand-file-name vm-primary-inbox))))
  1529.     (set-buffer mail-buffer)
  1530.     (or (buffer-modified-p) (setq vm-messages-not-on-disk 0))
  1531.     (let ((first-time (not (eq major-mode 'vm-mode)))
  1532.       (inhibit-quit t))
  1533.       (if first-time
  1534.       (progn
  1535.         (buffer-flush-undo (current-buffer))
  1536.         (abbrev-mode 0)
  1537.         (auto-fill-mode 0)
  1538.         (vm-mode)))
  1539.       (if (or (and vm-primary-inbox-p (vm-get-spooled-mail)) first-time)
  1540.       (progn
  1541.         (vm-assimilate-new-messages)
  1542.         ;; Can't allow a folder-empty error here because execution
  1543.         ;; would abort before the session startup code below.
  1544.         (if (null vm-message-list)
  1545.         (message "Folder is empty.")
  1546.           (vm-emit-totals-blurb)
  1547.           ;; If there's a current grouping, then the summary has already
  1548.           ;; been redone in vm-group-messages.
  1549.           (if (and vm-summary-buffer (not vm-current-grouping))
  1550.           (progn
  1551.             (vm-do-summary)
  1552.             ;; The summary update messages erased this info
  1553.             ;; from the echo area.
  1554.             (vm-emit-totals-blurb)))
  1555.           (save-window-excursion
  1556.         ;; Make sure the mail buffer is not visible.  This is
  1557.         ;; needed to insure that if vm-preview-lines is nil, the
  1558.         ;; mail window won't be momentarily displayed and then
  1559.         ;; disappear behind the summary window, if
  1560.         ;; vm-startup-with-summary is t.
  1561.         (if (get-buffer-window mail-buffer)
  1562.             (if (one-window-p)
  1563.             (switch-to-buffer (other-buffer))
  1564.               (delete-windows-on mail-buffer)))
  1565.         (set-buffer mail-buffer)
  1566.         (vm-thoughtfully-select-message))
  1567.           (if vm-summary-buffer
  1568.           (vm-set-summary-pointer (car vm-message-pointer))))))
  1569.       (switch-to-buffer mail-buffer)
  1570.       (if (and vm-message-list vm-startup-with-summary)
  1571.       (progn
  1572.         (vm-summarize t)
  1573.         (vm-emit-totals-blurb)
  1574.         (and (eq vm-startup-with-summary t)
  1575.          (eq vm-mutable-windows t)
  1576.          (if (eq major-mode 'vm-summary-mode)
  1577.              (delete-other-windows)
  1578.            (select-window (get-buffer-window vm-summary-buffer))
  1579.            (delete-other-windows))))
  1580.     (if (eq vm-mutable-windows t)
  1581.         (delete-other-windows)))
  1582.       (if vm-session-beginning
  1583.       (progn
  1584.         (setq vm-session-beginning nil)
  1585.         (or vm-inhibit-startup-message folder
  1586.         (vm-display-startup-message))
  1587.         (if (and vm-message-list (not (input-pending-p)))
  1588.         (vm-emit-totals-blurb)))))))
  1589.  
  1590. (defun vm-mode ()
  1591.   "Major mode for reading mail.
  1592.  
  1593. Commands:
  1594.    h - summarize folder contents
  1595.  
  1596.    n - go to next message
  1597.    p - go to previous message
  1598.    N - like `n' but ignores skip-variable settings
  1599.    P - like `p' but ignores skip-variable settings
  1600.  M-n - go to next unread message
  1601.  M-p - go to previous unread message
  1602.  RET - go to numbered message (uses prefix arg or prompts in minibuffer)
  1603.  TAB - go to last message seen
  1604.  M-s - incremental search through the folder
  1605.  
  1606.    t - display hidden headers
  1607.  SPC - scroll forward a page (if at end of message, then display next message)
  1608.    b - scroll backward a page
  1609.    > - go to end of current message
  1610.  
  1611.    d - delete current message (mark as deleted)
  1612.    u - undelete
  1613.    k - mark for deletion all messages with same subject as the current message
  1614.  
  1615.    r - reply (only to the sender of the message)
  1616.    R - reply with included text for current message
  1617.    f - followup (reply to all recipients of message)
  1618.    F - followup with included text from the current message
  1619.    z - forward the current message
  1620.    m - send a message
  1621.  
  1622.    @ - digestify and mail entire folder contents (the folder is not modified)
  1623.    * - burst a digest into indivdual messages, and append and assimilate these
  1624.        message into the current folder.
  1625.  
  1626.    G - group messages according to some criteria
  1627.  
  1628.    g - get any new mail that has arrived in the system mailbox
  1629.        (new mail is appended to the disk and buffer copies of the
  1630.        primary inbox.)
  1631.    v - visit another mail folder
  1632.  
  1633.    s - save current message in a folder (appends if folder already exists)
  1634.    w - write current message to a file without its headers (appends if exists)
  1635.    S - save entire folder to disk, expunging deleted messages
  1636.    A - save unfiled messages to their vm-auto-folder-alist specified folders
  1637.    # - expunge deleted messages (without saving folder)
  1638.    q - quit VM, deleted messages are expunged, folder saved to disk
  1639.    x - exit VM with no change to the folder
  1640.  
  1641.  C-_ - undo, special undo that retracts the most recent
  1642.              changes in message attributes.  Expunges and saves
  1643.              cannot be undone.
  1644.  
  1645.    ? - help
  1646.  
  1647.    ! - run a shell command
  1648.    | - run a shell command with the current message as input
  1649.  
  1650.  M-c - view conditions under which youmay redistribute of VM
  1651.  M-w - view the details of VM's lack of a warranty
  1652.  
  1653. Variables:
  1654.    vm-auto-folder-alist
  1655.    vm-berkeley-mail-compatibility
  1656.    vm-circular-folders
  1657.    vm-confirm-new-folders
  1658.    vm-crash-box
  1659.    vm-delete-after-saving
  1660.    vm-delete-empty-folders
  1661.    vm-folder-directory
  1662.    vm-folder-type
  1663.    vm-follow-summary-cursor
  1664.    vm-forwarding-subject-format
  1665.    vm-gargle-uucp
  1666.    vm-group-by
  1667.    vm-highlighted-header-regexp
  1668.    vm-in-reply-to-format
  1669.    vm-included-text-attribution-format
  1670.    vm-included-text-prefix
  1671.    vm-inhibit-startup-message
  1672.    vm-mail-window-percentage
  1673.    vm-mode-hooks
  1674.    vm-move-after-deleting
  1675.    vm-mutable-windows
  1676.    vm-preview-lines
  1677.    vm-preview-read-messages
  1678.    vm-primary-inbox
  1679.    vm-rfc934-forwarding
  1680.    vm-search-using-regexps
  1681.    vm-skip-deleted-messages
  1682.    vm-skip-read-messages
  1683.    vm-spool-files
  1684.    vm-startup-with-summary
  1685.    vm-strip-reply-headers
  1686.    vm-summary-format
  1687.    vm-visible-headers
  1688.    vm-visit-when-saving"
  1689.   (widen)
  1690.   (make-local-variable 'require-final-newline)
  1691.   (make-local-variable 'file-precious-flag)
  1692.   (setq
  1693.    buffer-read-only nil
  1694.    case-fold-search t
  1695.    file-precious-flag t
  1696.    major-mode 'vm-mode
  1697.    mode-line-format
  1698.    '("" mode-line-modified mode-line-buffer-identification "   "
  1699.      global-mode-string
  1700.      (vm-message-list
  1701.       ("   %[(" vm-ml-attributes-string ")%]----")
  1702.       ("   %[()%]----"))
  1703.      (-3 . "%p") "-%-")
  1704.    mode-line-buffer-identification
  1705.    '("VM " vm-version ": %b"
  1706.      (vm-message-list
  1707.       ("   " vm-ml-message-number
  1708.        " (of " vm-ml-highest-message-number ")")
  1709.       "  (no messages)"))
  1710.    mode-name "VM"
  1711.    require-final-newline nil
  1712.    vm-current-grouping vm-group-by
  1713.    vm-primary-inbox-p (equal buffer-file-name
  1714.                  (expand-file-name vm-primary-inbox)))
  1715.   (use-local-map vm-mode-map)
  1716.   (run-hooks 'vm-mode-hooks))
  1717.  
  1718. (put 'vm-mode 'mode-class 'special)
  1719.  
  1720. (autoload 'vm-group-messages "vm-group" nil t)
  1721.  
  1722. (autoload 'vm-reply "vm-reply" nil t)
  1723. (autoload 'vm-reply-include-text "vm-reply" nil t)
  1724. (autoload 'vm-followup "vm-reply" nil t)
  1725. (autoload 'vm-followup-include-text "vm-reply" nil t)
  1726. (autoload 'vm-mail "vm-reply" nil t)
  1727. (autoload 'vm-forward-message "vm-reply" nil t)
  1728. (autoload 'vm-send-digest "vm-reply" nil t)
  1729.  
  1730. (autoload 'vm-isearch-forward "vm-search" nil t)
  1731.  
  1732. (autoload 'vm-burst-digest "vm-digest" nil t)
  1733. (autoload 'vm-rfc934-char-stuff-region "vm-digest")
  1734. (autoload 'vm-digestify-region "vm-digest")
  1735.  
  1736. (autoload 'vm-show-no-warranty "vm-license" nil t)
  1737. (autoload 'vm-show-copying-restrictions "vm-license" nil t)
  1738.  
  1739. (autoload 'vm-auto-archive-messages "vm-save" nil t)
  1740. (autoload 'vm-save-message "vm-save" nil t)
  1741. (autoload 'vm-save-message-sans-headers "vm-save" nil t)
  1742. (autoload 'vm-pipe-message-to-command "vm-save" nil t)
  1743.  
  1744. (autoload 'vm-delete-message "vm-delete" nil t)
  1745. (autoload 'vm-undelete-message "vm-delete" nil t)
  1746. (autoload 'vm-kill-subject "vm-delete" nil t)
  1747. (autoload 'vm-expunge-folder "vm-delete" nil t)
  1748.  
  1749. (if (not (memq 'vm-write-file-hook write-file-hooks))
  1750.     (setq write-file-hooks
  1751.       (cons 'vm-write-file-hook write-file-hooks)))
  1752.